home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / misc / doscyber / src / gunbit.c < prev    next >
Encoding:
Text File  |  1995-02-16  |  28.6 KB  |  955 lines
  1. nstrate the GetImage and PutImage commands }
  2.  
  3. const
  4.   r  = 20;
  5.   StartX = 100;
  6.   StartY = 50;
  7.  
  8. var
  9.   CurPort : ViewPortType;
  10.  
  11. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  12. var
  13.   Step : integer;
  14. begin
  15.   Step := Random(2*r);
  16.   if Odd(Step) then
  17.     Step := -Step;
  18.   X := X + Step;
  19.   Step := Random(r);
  20.   if Odd(Step) then
  21.     Step := -Step;
  22.   Y := Y + Step;
  23.  
  24.   { Make saucer bounce off viewport walls }
  25.   with CurPort do
  26.   begin
  27.     if (x1 + X + Width - 1 > x2) then
  28.       X := x2-x1 - Width + 1
  29.     else
  30.       if (X < 0) then
  31.         X := 0;
  32.     if (y1 + Y + Height - 1 > y2) then
  33.       Y := y2-y1 - Height + 1
  34.     else
  35.       if (Y < 0) then
  36.         Y := 0;
  37.   end;
  38. end; { MoveSaucer }
  39.  
  40. var
  41.   Pausetime : word;
  42.   Saucer    : pointer;
  43.   X, Y      : integer;
  44.   ulx, uly  : word;
  45.   lrx, lry  : word;
  46.   Size      : word;
  47.   I         : word;
  48. begin
  49.   ClearDevice;
  50.   FullPort;
  51.  
  52.   { PaintScreen }
  53.   ClearDevice;
  54.   MainWindow('GetImage / PutImage Demonstration');
  55.   StatusLine('Esc aborts or press a key...');
  56.   GetViewSettings(CurPort);
  57.  
  58.   { DrawSaucer }
  59.   Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
  60.   Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
  61.   Line(StartX+7, StartY-6, StartX+10, StartY-12);
  62.   Circle(StartX+10, StartY-12, 2);
  63.   Line(StartX-7, StartY-6, StartX-10, StartY-12);
  64.   Circle(StartX-10, StartY-12, 2);
  65.   SetFillStyle(SolidFill, MaxColor);
  66.   FloodFill(StartX+1, StartY+4, GetColor);
  67.  
  68.   { ReadSaucerImage }
  69.   ulx := StartX-(r+1);
  70.   uly := StartY-14;
  71.   lrx := StartX+(r+1);
  72.   lry := StartY+(r div 3)+3;
  73.  
  74.   Size := ImageSize(ulx, uly, lrx, lry);
  75.   GetMem(Saucer, Size);
  76.   GetImage(ulx, uly, lrx, lry, Saucer^);
  77. {  PutImage(ulx, uly, Saucer^, XORput);               { erase image }
  78.  
  79.   { Plot some "stars" }
  80.   for I := 1 to 1000 do
  81.      PutPixel(Random(MaxX), Random(MaxY), RandColor);
  82.   X := MaxX div 2;
  83.   Y := MaxY div 2;
  84.   PauseTime := 70;
  85.  
  86.   { Move the saucer around }
  87.   repeat
  88. {     PutImage(X, Y, Saucer^, XORput);                 { draw image }
  89.      Delay(PauseTime);
  90. {     PutImage(X, Y, Saucer^, XORput);                 { erase image }
  91.      MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1);  { width/height }
  92.   until KeyPressed;
  93.   FreeMem(Saucer, size);
  94.   WaitToGo;
  95. end; { PutImagePlay }
  96.  
  97. procedure PolyPlay;
  98. { Draw random polygons with random fill styles on the screen }
  99. const
  100.   MaxPts = 5;
  101. type
  102.   PolygonType = array[1..MaxPts] of PointType;
  103. var
  104.   Poly : PolygonType;
  105.   I, Color : word;
  106. begin
  107.   MainWindow('FillPoly demonstration');
  108.   StatusLine('Esc aborts or press a key...');
  109.   repeat
  110.     Color := RandColor;
  111.     SetFillStyle(Random(11)+1, Color);
  112.     SetColor(Color);
  113.     for I := 1 to MaxPts do
  114.       with Poly[I] do
  115.       begin
  116.         X := Random(MaxX);
  117.         Y := Random(MaxY);
  118.       end;
  119.     FillPoly(MaxPts, Poly);
  120.   until KeyPressed;
  121.   WaitToGo;
  122. end; { PolyPlay }
  123.  
  124. procedure FillStylePlay;
  125. { Display all of the predefined fill styles available }
  126. var
  127.   Style    : word;
  128.   Width    : word;
  129.   Height   : word;
  130.   X, Y     : word;
  131.   I, J     : word;
  132.   ViewInfo : ViewPortType;
  133.  
  134. procedure DrawBox(X, Y : word);
  135. begin
  136.   SetFillStyle(Style, MaxColor);
  137.   with ViewInfo do
  138.     Bar(X, Y, X+Width, Y+Height);
  139.   Rectangle(X, Y, X+Width, Y+Height);
  140.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style));
  141.   Inc(Style);
  142. end; { DrawBox }
  143.  
  144. begin
  145.   MainWindow('Pre-defined fill styles');
  146.   GetViewSettings(ViewInfo);
  147.   with ViewInfo do
  148.   begin
  149.     Width := 2 * ((x2+1) div 13);
  150.     Height := 2 * ((y2-10) div 10);
  151.   end;
  152.   X := Width div 2;
  153.   Y := Height div 2;
  154.   Style := 0;
  155.   for J := 1 to 3 do
  156.   begin
  157.     for I := 1 to 4 do
  158.     begin
  159.       DrawBox(X, Y);
  160.       Inc(X, (Width div 2) * 3);
  161.     end;
  162.     X := Width div 2;
  163.     Inc(Y, (Height div 2) * 3);
  164.   end;
  165.   SetTextJustify(LeftText, TopText);
  166.   WaitToGo;
  167. end; { FillStylePlay }
  168.  
  169. procedure FillPatternPlay;
  170. { Display some user defined fill patterns }
  171. const
  172.   Patterns : array[0..11] of FillPatternType = (
  173.   ($AA, $55, $AA, $55, $AA, $55, $AA, $55 üÖü üÖü  !BBäx!!!BBäx!BBäx"""DDêp""DDêp>"""BBääêp""!"BDäêêp>IÉÆ|      ° @≥î>00>><Dêx  !BBäx""DDêp&<"DDêê&22TTêêê$> $< @äêp>          ⁿBBBB<  @@Ç****DDDDDDDU¬U¬U¬U¬U¬U¬U¬▌w▌w▌w▌w▌w▌w▌w°°°≥■°°≥≥■≥≥■■°°°    ≤  ≤  ≤≤         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       ;DDD;    $"Bdÿ>@@@>||>Ac]AAA1N"A""2,  `1NA"*III*<Bü üB<<BüüüB<A" \"QIE" < <BBBB  @@    ~ ?  @ÇB$$B ""A$$"AII6 üBr»$**IIII**ccregion.  The region is defined as any pixel of
  174.             OldColor which has a path of pixels of OldColor or NewColor
  175.             with sides touching back to the seed point, (XSeed, YSeed).
  176.             Therefore, only pixels of OldColor are modified and no other
  177.             information is changed.
  178.  
  179.             SEE ALSO
  180.  
  181.             DRWFILLBOX, DRWFILLCIRCLE, DRWFILLELLIPSE, FILLAREA,
  182.             FILLCONVEXPOLY, FILLPAGE, FILLPOLY, FILLSCREEN, FILLVIEW,
  183.             SETVIEW
  184.  
  185.             EXAMPL(HNxHHO$B<BBBB<$<BBBB<<BBBB<$BBBBBF:0BBBBF:$BBBF:B<""AAA""AAAAA"<B@@B<" <2\A">>xDDxDNDD <` <>BB= > <BBBB< BBBBF:2L\bBBBB&AaQIECA8$>""">0@@A>@@@ b$(. b$(*
  186.     $    $    $DDDDDDD¬U¬U¬U¬U¬U¬U¬Uw▌w▌w▌w▌w▌w▌w▌°°°⌠ⁿ°°⌠⌠ⁿ⌠⌠ⁿⁿ°°°    ≈  ≈  ≈≈         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       7HH7"B\DBBRL~BB@@@@@@?R~!!~?DDDD8BBBB|@@Ç>P>III>"AA""AAA"Uw<DDDD86II6"EIQ"\ @@ "AAAAA> >     hH02L2L$$<H(,$<>>>>>>>         VMODE=VIDEOMODEGET
  187.             IF WHICHVGA = 0 THEN STOP
  188.             DUMMY=RES640
  189.             SETVIEW 100, 100, 539, 379
  190.             FILLVIEW 10
  191.             WHILE INKEY$ = ""
  192.             WEND
  193.             VIDEOMODESET VMODE
  194.             END
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.                                                                          63
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.           FONTGETINFO
  219.  
  220.             PROTOTYPE
  221.  
  222.             SUB FONTGETINFO (Width%, Height%)
  223.  
  224.             INPUT
  225.  
  226.             no input parameters
  227.     WEND
  228.             MOUSEEXIT
  229.             VIDEOMODESET VMODE
  230.             END
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.                                                                          86
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.           MOUSECURSORDEFAULT
  279.  
  280.             PROTOTYPE
  281.  
  282.             SUB MOUSECURSORDEFAULT ()
  283.  
  284.             INPUT
  285.  
  286.             no input parameters
  287.  
  288.             OUTPUT
  289.  
  290.             no value returned
  291.  
  292.             USAGE
  293.  
  294.             MOUSECURSORDEFAULT defines the mouse cursor to be a small
  295.        ,K$╖┼╘╤░XQ)σ┤ö≡÷┴─┤àñT┘,╘¬àñX9╘⌠àñ\9╘UÜ╢≤`9╘4a╘d9╘UTa╘h9╘ta╘l9╘Uöa╘p9╘┤a╘t┘PT±x┴îÇ╖0▓ïα│ÅαU┤ôα╡ùα╢¢α╖úΓ╘pǺΓ╕¡αë ╚┴πì°sKÉφb<$⌡▌ë     φë φë I1φë  Eφë $YφÆë (mφë ,üφë 0$òφë á⌐φë ñ╜φë I¿╤φë ¼σφë ░∙φÆë 4
  296. ²ë ┤!²ë ╕$5²ë ╝I²ë └]²ë ⌐8q²ë <àⁿΦiǬ∙PÖÇ ¥Ç
  297. ⁿ
  298. ░╨â@%8@ΓΦá╝╤░≡cÑÅ*$
  299. ░╕≡ż≡τ╥m¿⌡ε    ╨@#µ≈$âh$âαra╨à`¥è∩Ç%Ç +─▀ TîcOî∩â°1<@  [$¿Ç¼ MMl·0ƒ Y¼─!%6a▐è ¥ì ßá+?±  P<îaTTV ╪iÇ¡≥░ `_ñ»%Çá᪠P█º»ε`éa∙É%H«┴íA%Gár∙É
  300. iw∙Éiφ`╧≥≡╤Çmⁿ▒
  301. ]ÆAáσw7░⌡∩    $·╟Ç√É&^`  ┐ $ⁿ  $■ $╒ nk$J-ÉQ1£PéBù »0αQ/Ñ4╜£░ºP≈Ñ4Ç⌡$(ª▀$@C]Æé≈└╕_SÇçÑ4=iÉ⌠ä╣<_np@Ñ45ò▒Y3ü¼Qí░.i>╠@5+┴╙É╛╙$@ #┴@«╦
  302. $╤
  303. #@Ñú4,p&e÷ü¼_ÇQºÑ4
  304. òQ  ü@;¡_áQ@e╠≥@mp!┤a╘O░√`Pñź ÇT°8ÿ!¼Åñ$½╙"q¿ PñCÇ¿α√└╥░eT"ß<p°%Pæ(╧%pδ¥/OêW0Ǽbφ φ B@[â¼8â≥µ≤(    ¿⌡%(Ç∩áTÿp+ óÜ▓0!Σ±(1±
  305. ░┤ÖÇD└D0Å╡`   $ «îO@╧1
  306. a╝╤j-0ñ│`@╖bΦaT1═⌠╝╤Σ²¼±,1öíî9lÿ28ÇÅ`Γî¿P²$,N0┴O0a╫δ≤0σú`°î╖#0δ≡└X▄1»Σî(▒¥Ç█Ñ"qá√1CÇú╟╨º Å
  307. FT Θ²î└1ÇY0    w ²à░$@AÅ`╦Φ¼╘`▄1A  }┐Ç*5 ΩSδδî`¼îaδæ¼î5 1¿⌡Ω╜⌠ ¼¥╬ü└Qî1S
  308. ╛≤î9╨iÇ,∙PU(}Ç$üÇ àÇ`σìÇ`QαÜBO$%ÿÇ╧"$Ç«Ç]É.┬\`%WÉ$  W0 ÄâO0]αG┬ur╩
  309. ░£▒
  310. Q¢ú╔Ç≡°s?`X0╘`@ µWâ@╣aá εdq`¥9?Ç&+o0µyÄΣAÅuV(7P╬±@IdQ╕@Å┤@;Ç▓?Çò│CÇ┤╟╨╡KÇÄ30ⁿφ° ó╬ì+]Ä╦≡     Mö╝σ ²y5<!└▀óâ╝É3~mp    $<╛≤9Æ-2ⁿ≡@T,╞Σa,)Pæ└¥#¼╪Q┤S(¼@Aîa
  311. ≡╤@Ö²±⌠KëD─┴▒▀0╨Ñ$╩-0 ╨ê*╙▓edm`î=3Kß-10è=≥≤²└£mîjy ÿe²ⁿ╨i╕e▓ΣmαÖ╢C%Ç*ê*0 EátQZ`mÄLP%    °üⁿªüNQ∙  T¿<qtWΩc z░ÅÇñΩçǪçÇ«;└<┐á¼¥. á?<Σscî)áí := 0;
  312.       end;
  313.     end;
  314.   end;
  315.   WaitToGo;
  316. end; { UserLineStylePlay }
  317.  
  318.  
  319. procedure SayGoodbye;
  320. { Say goodbye and then exit the program }
  321. var
  322.   ViewInfo : ViewPortType;
  323. begin
  324.   MainWindow('');
  325.   GetViewSettings(ViewInfo);
  326.   SetTextStyle(TriplexFont, HorizDir, 4);
  327.   SetTextJustify(CenterText, CenterText);
  328.   with ViewInfo do
  329.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'That''s all folks!');
  330.   StatusLine('Press any key to quit...');
  331.   repeat until KeyPressed;
  332. end; { SayGoodbye }
  333.  
  334.  
  335. PROCEDURE SelectMode;
  336. VAR
  337.     choice1,choice2     : CHAR;
  338.    xsize,ysize            : WORD;
  339. BEGIN
  340.     (* Let's select a mode *)
  341.     ClrScr;
  342.     WriteLn('VESADEMO:');
  343.     WriteLn('1. 256 colors');
  344.     WriteLn('2. 32768 colors');
  345.     WriteLn('3. 65536 colors');
  346.     WriteLn('4. 16777216 colors');
  347.     WriteLn('Q uit');
  348.     WriteLn;
  349.     Write('Your choice: ');
  350.     REPEAT
  351.         ReadLn(choice1);
  352.       IF choice1 <> '1' THEN BEGIN
  353.           WriteLn('Sorry !');
  354.          WriteLn('This demo wasn''t written for more as 256 colors !');
  355.          WriteLn('You would only get a limited impression of the Hi-& TrueColor modes...');
  356.          WriteLn('Switching to 256 colors.');
  357.          choice1 := '1';
  358.       END;
  359.     UNTIL choice1 IN ['1'..'4','q'];
  360.     IF choice1 = 'q' THEN Halt;
  361.  
  362.     WriteLn;
  363.     WriteLn;
  364.     WriteLn('a. 320x200');
  365.     WriteLn('b. 640x480');
  366.     WriteLn('c. 800x600');
  367.     WriteLn('d. 1024x768');
  368.     WriteLn('e. 1280x1024');
  369.     WriteLn('Q uit');
  370.     WriteLn;
  371.     Write('Your choice: ');
  372.     REPEAT
  373.         ReadLn(choice2);
  374.     UNTIL choice2 IN ['a'..'e','q'];
  375.     IF choice2 = 'q' THEN Halt;
  376.  
  377.     CASE choice2 OF
  378.         'a' : BEGIN
  379.             xsize := 320;
  380.             ysize := 200;
  381.         END;
  382.         'b' : BEGIN
  383.             xsize := 640;
  384.             ysize := 480;
  385.         END;
  386.         'c' : BEGIN
  387.             xsize := 800;
  388.             ysize := 600;
  389.         END;
  390.         'd' : BEGIN
  391.             xsize := 1024;
  392.             ysize := 768;
  393.         END;
  394.         'e' : BEGIN
  395.             xsize := 1280;
  396.             ysize := 1024;
  397.         END;
  398.     END;
  399.     CASE choice1 OF
  400.         '1' : mode := FindVesaMode(xsize,ysize,8);
  401.         '2' : mode := FindVesaMode(xsize,ysize,15);
  402.         '3' : mode := FindVesaMode(xsize,ysize,16);
  403.         '4' : mode := FindVesaMode(xsize,ysize,24);
  404.     END;
  405.     IF mode = 0 THEN BEGIN
  406.         WriteLn('No such mode could be found !');
  407.         WriteLn('Switching to to 320x200.');
  408.         ReadKey;
  409.         mode := V320x200x256;
  410.     END;
  411. END;
  412.  
  413. begin { program body }
  414.   SelectMode;
  415.   Initialize;
  416.   ReportStatus;
  417.  
  418. {  AspectRatioPlay; }
  419.   FillEllipsePlay;
  420.   SectorPlay;
  421.   WriteModePlay;
  422.  
  423.   ColorPlay;
  424.   { PalettePlay only intended to work on these drivers: }
  425.   if (GraphDriver = EGA) or
  426.       (GraphDriver = EGA64) or
  427.       (GraphDriver = VGA) then
  428.      PalettePlay;
  429.   PutPixelPlay;
  430. {  PutImagePlay; }
  431.   RandBarPlay;
  432.   BarPlay;
  433.   Bar3DPlay;
  434.   ArcPlay;
  435.   CirclePlay;
  436.   PiePlay;
  437.   LineToPlay;
  438.   LineRelPlay;
  439. {  LineStylePlay; }
  440. {  UserLineStylePlay; }
  441.   TextDump;
  442.   TextPlay;
  443.   CrtModePlay;
  444.   FillStylePlay;
  445.   FillPatternPlay;
  446.   PolyPlay;
  447.   SayGoodbye;
  448. {  CloseGraph; }
  449.   CloseVesa;
  450. end.
  451. ***************************************************
  452.     '* SHOW D2ROTATE (ABOUT THE ORIGIN)
  453.     '****************************************************************∞╥≤c≤*φè#^│v/╒:j═φ0t+l▓ô"¬"g└≡?%ªêΣ│H╫½╫╜├¿U'╒⌐⌡ ßV?╩
  454. ¬ujOΦçEZ1∞▐! ▄B╛Σ8║æ]1GlNÜ┐q▌▓;ô$ΦzE<cª*bEô#ä╧ñÅ"∩─LrdaÖ ╠º╫a^¥£å╬1~)@ëÖMδ╫0═6DäFê¬Çv┼ß╨kæpτ╪É)}ª 1w3╤╧ü⌡¥╓h▓╣≈ïÅaÑ[TⁿHqªÉ╝DKÄ─Y-∞tT╤Θ╨º╟╪.*ÇI9lΦ≈{πτcσ$τπßoFr╪╨∩┼╞╟;O2■e²LÜ4^N|╪½ÅO?╔°FOz`╟╟╟'<>>π$πΘù6·
  455. Xgî╖│°oîδπGƒd╝▀░?■╪╔_9L ⌡ôⁿq'æO▀ƒn4╔▀╚▄┼3pτ.òO°·}÷╕ⁿ±'æO?ít│!√8ßÑ≤/┐╣p┼≥┘E╦Vox╕cΦé5╟╚º╙$?√$≥ΘZεsî≡åìΓpKù¢ïß X╥ 9╞≈\µk┤O¥_ 5Üö\≤éÄ┌╤A[╤ÿáï┼éNⁿÅu16    g,%hc╙╨cD╨Vï┘R¢öKñR;8εáΣ╢╪ós╤π╡á└èxgzPÄMú╫yαºÉ+σJ¢i+▓â3╥    ═Ñ╙î^ºG▓█πérφçs %#(╗⌠?┼%u8≡6+QÉ))ò)Afw≈╣╪)B&4░åLXV:δät@Å.;5Φf╢Ät┐ΣJ╫─U8úÇ╟éö£╕p╔┴⌠vg╨╬╥é÷╪╣┬ΓI.ç≡^v╤ZΦÇ& ╒┌6ñô6XßNè╡╬E₧Ñ
  456. kIº╠▄A+╣╥éb²tæ-Y¡½αÑa═uuîÇ╢αêvhuª╡SÅ┤vèùú¥F;p<d⌐/F─d█éT%▓KΦû=q■öI┐ ┐╠6S$▒÷╚ENΩ¥Fû9╔┌R'╝ ╧φ└?g┬j▓0═/b╖₧─mûé╢┌»ÿÄë/·<éò■░╤╟╢├Xσ:╥P3Θ"╬Læsφ░┌öSö!╗¿*mN£WΣÇ£┤~#╗ææ≥RΩóh:à▌.æ≈╕▌v£äàd▒à╒├=░╖π║$howeg*╬    6ù▄ƒô╕φ░Ö╢qΘD>(w@úKεHÆ╛öúΣU
  457. éÜR╔╤W▄èê 2M%ó.▓SNÖA1ùJE╢║l]▓¿>\%└Å4ßO▄£â⌐& ê/)8vSP▀▓ôⁿææ√ü√ÑÄa⌠â╚4S╓╟P- ?Σá╕▓Næ*q╡UΘ▓≈^ñ·I.rúR&$Y^╚%è≡B┌≈Ceat
  458.     Color := RandColor;
  459.     SetColor(Color);
  460.     SetFillStyle(Random(CloseDotFill)+1, Color);
  461.     Bar3D(Random(MaxWidth), Random(MaxHeight),
  462.           Random(MaxWidth), Random(MaxHeight), 0, TopOff);
  463.   until KeyPressed;
  464.   WaitToGo;
  465. end; { RandBarPlay }
  466.  
  467. procedure ArcPlay;
  468. { Draw random arcs on the screen }
  469. var
  470.   MaxRadius : word;
  471.   EndAngle : word;
  472.   ArcInfo : ArcCoordsType;
  473. begin
  474.   MainWindow('Arc / GetArcCoords demonstration');
  475.   StatusLine('Esc aborts or press a key');
  476.   MaxRadius := MaxY div 10;
  477.   repeat
  478.     SetColor(RandColor);
  479.     EndAngle := Random(360);
  480.     SetLineStyle(SolidLn, 0, NormWidth);
  481.     Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius));
  482.     GetArcCoords(ArcInfo);
  483.     with ArcInfo do
  484.     begin
  485.       Line(X, Y, XStart, YStart);
  486.       Line(X, Y, Xend, Yend);
  487.     end;
  488.   until KeyPressed;
  489.   WaitToGo;
  490. end; { ArcPlay }
  491.  
  492. procedure PutPixelPlay;
  493. { Demonstrate the PutPixel and GetPixel commands }
  494. const
  495.   Seed   = 1962; { A seed for the random number generator }
  496.   NumPts = 2000; { The number of pixels plotted }
  497.   Esc    = #27;
  498. var
  499.   I : word;
  500.   X, Y, Color : word;
  501.   XMax, YMax  : integer;
  502.   ViewInfo    : ViewPortType;
  503. begin
  504.   MainWindow('PutPixel / GetPixel demonstration');
  505.   StatusLine('Esc aborts or press a key...');
  506.  
  507.   GetViewSettings(ViewInfo);
  508.   with ViewInfo do
  509.   begin
  510.     XMax := (x2-x1-1);
  511.     YMax := (y2-y1-1);
  512.   end;
  513.  
  514.   while not KeyPressed do
  515.   begin
  516.     { Plot random pixels }
  517.     RandSeed := Seed;
  518.     I := 0;
  519.     while (not KeyPressed) and (I < NumPts) do
  520.     begin
  521.       Inc(I);
  522.         PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor);
  523.     end;
  524.  
  525.     { Erase pixels }
  526.     RandSeed := Seed;
  527.     I := 0;
  528.     while (not KeyPressed) and (I < NumPts) do
  529.     begin
  530.       Inc(I);
  531.       X := Random(XMax)+1;
  532.       Y := Random(YMax)+1;
  533.       Color := GetPixel(X, Y);
  534.         if Color = RandColor then
  535.           PutPixel(X, Y, 0);
  536.      end;
  537.   end;
  538.   WaitToGo;
  539. end; { PutPixelPlay }
  540.  
  541. procedure PutImagePlay;
  542. { Demonstrate the GetImage and PutImage commands }
  543.  
  544. const
  545.   r  = 20;
  546.   StartX = 100;
  547.   StartY = 50;
  548.  
  549. var
  550.   CurPort : ViewPortType;
  551.  
  552. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  553. var
  554.   Step : integer;
  555. begin
  556.   Step := Random(2*r);
  557.   if Odd(Step) then
  558.     Step := -Step;
  559.   X := X + Step;
  560.   Step := Random(r);
  561.   if Odd(Step) then
  562.     Step := -Step;
  563.   Y := Y + Step;
  564.  
  565.   { Make saucer bounce off viewport walls }
  566.   with CurPort do
  567.   begin
  568.     if (x1 + X + Width - 1 > x2) then
  569.       X := x2-x1 - Width + 1
  570.     else
  571.       if (X < 0) then
  572.         X := 0;
  573.     if (y1 + Y + Height - 1 > y2) then
  574.       Y := y2-y1 - Height + 1
  575.     else
  576.       if (Y < 0) then
  577.         Y := 0;
  578.   end;
  579. end; { MoveSaucer }
  580.  
  581. var
  582.   Pausetime : word;
  583.   Saucer    : pointer;
  584.   X, Y      : integer;
  585.   ulx, uly  : word;
  586.   lrx, lry  : word;
  587.   Size      : word;
  588.   I         : word;
  589. begin
  590.   ClearDevice;
  591.   FullPort;
  592.  
  593.   { PaintScreen }
  594.   ClearDevice;
  595.   MainWindow('GetImage / PutImage Demonstration');
  596.   StatusLine('Esc aborts or press a key...');
  597.   GetViewSettings(CurPort);
  598.  
  599.   { DrawSaucer }
  600.   Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
  601.   Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
  602.   Line(StartX+7, StartY-6, StartX+10, StartY-12);
  603.   Circle(StartX+10, StartY-12, 2);
  604.   Line(StartX-7, StartY-6, StartX-10, StartY-12);
  605.   Circle(StartX-10, StartY-12, 2);
  606.   SetFillStyle(SolidFill, MaxColor);
  607.   FloodFill(StartX+1, StartY+4, GetColor);
  608.  
  609.   { ReadSaucerImage }
  610.   ulx := StartX-(r+1);
  611.   uly := StartY-14;
  612.   lrx := StartX+(r+1);
  613.   lry := StartY+(r div 3)+3;
  614.  
  615.   Size := ImageSize(ulx, uly, lrx, lry);
  616.   GetMem(Saucer, Size);
  617.   GetImage(ulx, uly, lrx, lry, Saucer^);
  618. {  PutImage(ulx, uly, Saucer^, XORput);               { erase image }
  619.  
  620.   { Plot some "stars" }
  621.   for I := 1 to 1000 do
  622.      PutPixel(Random(MaxX), Random(MaxY), RandColor);
  623.   X := MaxX div 2;
  624.   Y := MaxY div 2;
  625.   PauseTime := 70;
  626.  
  627.   { Move the saucer around }
  628.   repeat
  629. {     PutImage(X, Y, Saucer^, XORput);                 { draw image }
  630.      Delay(PauseTime);
  631. {     PutImage(X, Y, Saucer^, XORput);                 { erase image }
  632.      MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1);  { width/height }
  633.   until KeyPressed;
  634.   FreeMem(Saucer, size);
  635.   WaitToGo;
  636. end; { PutImagePlay }
  637.  
  638. procedure PolyPlay;
  639. { Draw random polygons with random fill styles on the screen }
  640. const
  641.   MaxPts = 5;
  642. type
  643.   PolygonType = array[1..MaxPts] of PointType;
  644. var
  645.   Poly : PolygonType;
  646.   I, Color : word;
  647. begin
  648.   MainWindow('FillPoly demonstration');
  649.   StatusLine('Esc aborts or press a key...');
  650.   repeat
  651.     Color := RandColor;
  652.     SetFillStyle(Random(11)+1, Color);
  653.     SetColor(Color);
  654.     for I := 1 to MaxPts do
  655.       with Poly[I] do
  656.       begin
  657.         X := Random(MaxX);
  658.         Y := Random(MaxY);
  659.       end;
  660.     FillPoly(MaxPts, Poly);
  661.   until KeyPressed;
  662.   WaitToGo;
  663. end; { PolyPlay }
  664.  
  665. procedure FillStylePlay;
  666. { Display all of the predefined fill styles available }
  667. var
  668.   Style    : word;
  669.   Width    : word;
  670.   Height   : word;
  671.   X, Y     : word;
  672.   I, J     : word;
  673.   ViewInfo : ViewPortType;
  674.  
  675. procedure DrawBox(X, Y : word);
  676. begin
  677.   SetFillStyle(Style, MaxColor);
  678.   with ViewInfo do
  679.     Bar(X, Y, X+Width, Y+Height);
  680.   Rectangle(X, Y, X+Width, Y+Height);
  681.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style));
  682.   Inc(Style);
  683. end; { DrawBox }
  684.  
  685. begin
  686.   MainWindow('Pre-defined fill styles');
  687.   GetViewSettings(ViewInfo);
  688.   with ViewInfo do
  689.   begin
  690.     Width := 2 * ((x2+1) div 13);
  691.     Height := 2 * ((y2-10) div 10);
  692.   end;
  693.   X := Width div 2;
  694.   Y := Height div 2;
  695.   Style := 0;
  696.   for J := 1 to 3 do
  697.   begin
  698.     for I := 1 to 4 do
  699.     begin
  700.       DrawBox(X, Y);
  701.       Inc(X, (Width div 2) * 3);
  702.     end;
  703.     X := Width div 2;
  704.     Inc(Y, (Height div 2) * 3);
  705.   end;
  706.   SetTextJustify(LeftText, TopText);
  707.   WaitToGo;
  708. end; { FillStylePlay }
  709.  
  710. procedure FillPatternPlay;
  711. { Display some user defined fill patterns }
  712. const
  713.   Patterns : array[0..11] of FillPatternType = (
  714.   ($AA, $55, $AA, $55, $AA, $55, $AA, $55 üÖü üÖü  !BBäx!!!BBäx!BBäx"""DDêp""DDêp>"""BBääêp""!"BDäêêp>IÉÆ|      ° @≥î>00>><Dêx  !BBäx""DDêp&<"DDêê&22TTêêê$> $< @äêp>          ⁿBBBB<  @@Ç****DDDDDDDU¬U¬U¬U¬U¬U¬U¬▌w▌w▌w▌w▌w▌w▌w°°°≥■°°≥≥■≥≥■■°°°    ≤  ≤  ≤≤         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       ;DDD;    $"Bdÿ>@@@>||>Ac]AAA1N"A""2,  `1NA"*III*<Bü üB<<BüüüB<A" \"QIE" < <BBBB  @@    ~ ?  @ÇB$$B ""A$$"AII6 üBr»$**IIII**ccregion.  The region is defined as any pixel of
  715.             OldColor which has a path of pixels of OldColor or NewColor
  716.             with sides touching back to the seed point, (XSeed, YSeed).
  717.             Therefore, only pixels of OldColor are modified and no other
  718.             information is changed.
  719.  
  720.             SEE ALSO
  721.  
  722.             DRWFILLBOX, DRWFILLCIRCLE, DRWFILLELLIPSE, FILLAREA,
  723.             FILLCONVEXPOLY, FILLPAGE, FILLPOLY, FILLSCREEN, FILLVIEW,
  724.             SETVIEW
  725.  
  726.             EXAMPL(HNxHHO$B<BBBB<$<BBBB<<BBBB<$BBBBBF:0BBBBF:$BBBF:B<""AAA""AAAAA"<B@@B<" <2\A">>xDDxDNDD <` <>BB= > <BBBB< BBBBF:2L\bBBBB&AaQIECA8$>""">0@@A>@@@ b$(. b$(*
  727.     $    $    $DDDDDDD¬U¬U¬U¬U¬U¬U¬Uw▌w▌w▌w▌w▌w▌w▌°°°⌠ⁿ°°⌠⌠ⁿ⌠⌠ⁿⁿ°°°    ≈  ≈  ≈≈         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       7HH7"B\DBBRL~BB@@@@@@?R~!!~?DDDD8BBBB|@@Ç>P>III>"AA""AAA"Uw<DDDD86II6"EIQ"\ @@ "AAAAA> >     hH02L2L$$<H(,$<>>>>>>>         VMODE=VIDEOMODEGET
  728.             IF WHICHVGA = 0 THEN STOP
  729.             DUMMY=RES640
  730.             SETVIEW 100, 100, 539, 379
  731.             FILLVIEW 10
  732.             WHILE INKEY$ = ""
  733.             WEND
  734.             VIDEOMODESET VMODE
  735.             END
  736.  
  737.  
  738.  
  739.  
  740.  
  741.  
  742.  
  743.  
  744.  
  745.  
  746.  
  747.  
  748.  
  749.  
  750.  
  751.  
  752.                                                                          63
  753.  
  754.  
  755.  
  756.  
  757.  
  758.  
  759.           FONTGETINFO
  760.  
  761.             PROTOTYPE
  762.  
  763.             SUB FONTGETINFO (Width%, Height%)
  764.  
  765.             INPUT
  766.  
  767.             no input parameters
  768.     WEND
  769.             MOUSEEXIT
  770.             VIDEOMODESET VMODE
  771.             END
  772.  
  773.  
  774.  
  775.  
  776.  
  777.  
  778.  
  779.  
  780.  
  781.  
  782.  
  783.  
  784.  
  785.  
  786.  
  787.  
  788.  
  789.  
  790.  
  791.  
  792.  
  793.  
  794.  
  795.  
  796.  
  797.  
  798.  
  799.  
  800.  
  801.  
  802.  
  803.  
  804.  
  805.  
  806.  
  807.  
  808.  
  809.  
  810.  
  811.  
  812.                                                                          86
  813.  
  814.  
  815.  
  816.  
  817.  
  818.  
  819.           MOUSECURSORDEFAULT
  820.  
  821.             PROTOTYPE
  822.  
  823.             SUB MOUSECURSORDEFAULT ()
  824.  
  825.             INPUT
  826.  
  827.             no input parameters
  828.  
  829.             OUTPUT
  830.  
  831.             no value returned
  832.  
  833.             USAGE
  834.  
  835.             MOUSECURSORDEFAULT defines the mouse cursor to be a small
  836.        ,K$╖┼╘╤░XQ)σ┤ö≡÷┴─┤àñT┘,╘¬àñX9╘⌠àñ\9╘UÜ╢≤`9╘4a╘d9╘UTa╘h9╘ta╘l9╘Uöa╘p9╘┤a╘t┘PT±x┴îÇ╖0▓ïα│ÅαU┤ôα╡ùα╢¢α╖úΓ╘pǺΓ╕¡αë ╚┴πì°sKÉφb<$⌡▌ë     φë φë I1φë  Eφë $YφÆë (mφë ,üφë 0$òφë á⌐φë ñ╜φë I¿╤φë ¼σφë ░∙φÆë 4
  837. ²ë ┤!²ë ╕$5²ë ╝I²ë └]²ë ⌐8q²ë <àⁿΦiǬ∙PÖÇ ¥Ç
  838. ⁿ
  839. ░╨â@%8@ΓΦá╝╤░≡cÑÅ*$
  840. ░╕≡ż≡τ╥m¿⌡ε    ╨@#µ≈$âh$âαra╨à`¥è∩Ç%Ç +─▀ TîcOî∩â°1<@  [$¿Ç¼ MMl·0ƒ Y¼─!%6a▐è ¥ì ßá+?±  P<îaTTV ╪iÇ¡≥░ `_ñ»%Çá᪠P█º»ε`éa∙É%H«┴íA%Gár∙É
  841. iw∙Éiφ`╧≥≡╤Çmⁿ▒
  842. ]ÆAáσw7░⌡∩    $·╟Ç√É&^`  ┐ $ⁿ  $■ $╒ nk$J-ÉQ1£PéBù »0αQ/Ñ4╜£░ºP≈Ñ4Ç⌡$(ª▀$@C]Æé≈└╕_SÇçÑ4=iÉ⌠ä╣<_np@Ñ45ò▒Y3ü¼Qí░.i>╠@5+┴╙É╛╙$@ #┴@«╦
  843. $╤
  844. #@Ñú4,p&e÷ü¼_ÇQºÑ4
  845. òQ  ü@;¡_áQ@e╠≥@mp!┤a╘O░√`Pñź ÇT°8ÿ!¼Åñ$½╙"q¿ PñCÇ¿α√└╥░eT"ß<p°%Pæ(╧%pδ¥/OêW0Ǽbφ φ B@[â¼8â≥µ≤(    ¿⌡%(Ç∩áTÿp+ óÜ▓0!Σ±(1±
  846. ░┤ÖÇD└D0Å╡`   $ «îO@╧1
  847. a╝╤j-0ñ│`@╖bΦaT1═⌠╝╤Σ²¼±,1öíî9lÿ28ÇÅ`Γî¿P²$,N0┴O0a╫δ≤0σú`°î╖#0δ≡└X▄1»Σî(▒¥Ç█Ñ"qá√1CÇú╟╨º Å
  848. FT Θ²î└1ÇY0    w ²à░$@AÅ`╦Φ¼╘`▄1A  }┐Ç*5 ΩSδδî`¼îaδæ¼î5 1¿⌡Ω╜⌠ ¼¥╬ü└Qî1S
  849. ╛≤î9╨iÇ,∙PU(}Ç$üÇ àÇ`σìÇ`QαÜBO$%ÿÇ╧"$Ç«Ç]É.┬\`%WÉ$  W0 ÄâO0]αG┬ur╩
  850. ░£▒
  851. Q¢ú╔Ç≡°s?`X0╘`@ µWâ@╣aá εdq`¥9?Ç&+o0µyÄΣAÅuV(7P╬±@IdQ╕@Å┤@;Ç▓?Çò│CÇ┤╟╨╡KÇÄ30ⁿφ° ó╬ì+]Ä╦≡     Mö╝σ ²y5<!└▀óâ╝É3~mp    $<╛≤9Æ-2ⁿ≡@T,╞Σa,)Pæ└¥#¼╪Q┤S(¼@Aîa
  852. ≡╤@Ö²±⌠KëD─┴▒▀0╨Ñ$╩-0 ╨ê*╙▓edm`î=3Kß-10è=≥≤²└£mîjy ÿe²ⁿ╨i╕e▓ΣmαÖ╢C%Ç*ê*0 EátQZ`mÄLP%    °üⁿªüNQ∙  T¿<qtWΩc z░ÅÇñΩçǪçÇ«;└<┐á¼¥. á?<Σscî)áí := 0;
  853.       end;
  854.     end;
  855.   end;
  856.   WaitToGo;
  857. end; { UserLineStylePlay }
  858.  
  859.  
  860. procedure SayGoodbye;
  861. { Say goodbye and then exit the program }
  862. var
  863.   ViewInfo : ViewPortType;
  864. begin
  865.   MainWindow('');
  866.   GetViewSettings(ViewInfo);
  867.   SetTextStyle(TriplexFont, HorizDir, 4);
  868.   SetTextJustify(CenterText, CenterText);
  869.   with ViewInfo do
  870.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'That''s all folks!');
  871.   StatusLine('Press any key to quit...');
  872.   repeat until KeyPressed;
  873. end; { SayGoodbye }
  874.  
  875.  
  876. PROCEDURE SelectMode;
  877. VAR
  878.     choice1,choice2     : CHAR;
  879.    xsize,ysize            : WORD;
  880. BEGIN
  881.     (* Let's select a mode *)
  882.     ClrScr;
  883.     WriteLn('VESADEMO:');
  884.     WriteLn('1. 256 colors');
  885.     WriteLn('2. 32768 colors');
  886.     WriteLn('3. 65536 colors');
  887.     WriteLn('4. 16777216 colors');
  888.     WriteLn('Q uit');
  889.     WriteLn;
  890.     Write('Your choice: ');
  891.     REPEAT
  892.         ReadLn(choice1);
  893.       IF choice1 <> '1' THEN BEGIN
  894.           WriteLn('Sorry !');
  895.          WriteLn('This demo wasn''t written for more as 256 colors !');
  896.          WriteLn('You would only get a limited impression of the Hi-& TrueColor modes...');
  897.          WriteLn('Switching to 256 colors.');
  898.          choice1 := '1';
  899.       END;
  900.     UNTIL choice1 IN ['1'..'4','q'];
  901.     IF choice1 = 'q' THEN Halt;
  902.  
  903.     WriteLn;
  904.     WriteLn;
  905.     WriteLn('a. 320x200');
  906.     WriteLn('b. 640x480');
  907.     WriteLn('c. 800x600');
  908.     WriteLn('d. 1024x768');
  909.     WriteLn('e. 1280x1024');
  910.     WriteLn('Q uit');
  911.     WriteLn;
  912.     Write('Your choice: ');
  913.     REPEAT
  914.         ReadLn(choice2);
  915.     UNTIL choice2 IN ['a'..'e','q'];
  916.     IF choice2 = 'q' THEN Halt;
  917.  
  918.     CASE choice2 OF
  919.         'a' : BEGIN
  920.             xsize := 320;
  921.             ysize := 200;
  922.         END;
  923.         'b' : BEGIN
  924.             xsize := 640;
  925.             ysize := 480;
  926.         END;
  927.         'c' : BEGIN
  928.             xsize := 800;
  929.             ysize := 600;
  930.         END;
  931.         'd' : BEGIN
  932.             xsize := 1024;
  933.             ysize := 768;
  934.         END;
  935.         'e' : BEGIN
  936.             xsize := 1280;
  937.             ysize := 1024;
  938.         END;
  939.     END;
  940.     CASE choice1 OF
  941.         '1' : mode := FindVesaMode(xsize,ysize,8);
  942.         '2' : mode := FindVesaMode(xsize,ysize,15);
  943.         '3' : mode := FindVesaMode(xsize,ysize,16);
  944.         '4' : mode := FindVesaMode(xsize,ysize,24);
  945.     END;
  946.     IF mode = 0 THEN BEGIN
  947.         WriteLn('No such mode could be found !');
  948.         WriteLn('Switching to to 320x200.');
  949.         ReadKey;
  950.         mode := V320x200x256;
  951.     END;
  952. END;
  953.  
  954. begin { program body }
  955.   SelectMode;
  956.   Initialize;
  957.   ReportStatus;
  958.  
  959. {  AspectRatioPlay; }
  960.   FillEllipsePlay;
  961.   SectorPlay;
  962.   WriteModePlay;
  963.  
  964.   ColorPlay;
  965.   { PalettePlay only intended to work on these drivers: }
  966.   if (GraphDriver = EGA) or
  967.       (GraphDriver = EGA64) or
  968.       (GraphDriver = VGA) then
  969.      PalettePlay;
  970.   PutPixelPlay;
  971. {  PutImagePlay; }
  972.   RandBarPlay;
  973.   BarPlay;
  974.   Bar3DPlay;
  975.   ArcPlay;
  976.   CirclePlay;
  977.   PiePlay;
  978.   LineToPlay;
  979.   Li